Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / LIST.TPX < prev next >

Wrap

Text File | 1994-03-02 | 26KB | 543 lines

#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐ #!│ List.TPX │Version: 3007.105│ #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤ #!│Structure Type Description │ #!│──────────────────── ───────── ─────────────────────────────────────────│ #!│List PROCEDURE Scroll records from a file from a memory │ #!│ queue │ #!│ShowFileProgress GROUP │ #!│ListErrorCheck GROUP │ #!│BuildListIndex GROUP │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Repaired the LIST Procedure │ #!│3007.105 Repaired the LIST Procedure │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #PROCEDURE(List,'Scroll all selected records from a file'),SCREEN,PULLDOWN #! #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐ #!│ List │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│ The List template loads the entire set of selected records into │ #!│ a memory queue for displaying with a list box structure. │ #!│ │ #!│ Since the entire queue is filled at load time, this template should │ #!│ not be used with very large files as they may overflow the primary │ #!│ virtual memory area and spill over to disk. The result would be │ #!│ a listbox which works very slow and accesses the hard disk drive when │ #!│ scrolling. │ #!│ │ #!│ A checkbox is available to view a file in Record order. This is │ #!│ primarily useful in viewing ASCII, DOS, or BASIC files. │ #!│ (The View template may also be used.) │ #!│ │ #!│ If the Record Order checkbox is on, any reference to the │ #!│ PrimaryKey is ignored. Deletes, and Updates may not be allowed │ #!│ with certain non-keyed data file types. │ #!│ │ #!│ Also, a checkbox is available to display the queue in reverse │ #!│ order. If both the Record Order checkbox, and the Reverse Order │ #!│ checkbox are on then the file will be displayed in Reverse record │ #!│ order. If Just the Reverse Order checkbox is on, the file │ #!│ will be displayed in Reverse key order. │ #!│ │ #!│ Use with an Update Procedure: │ #!│ │ #!│ Since a Form template allows the multiple add ability, and │ #!│ since a List procedure may be used on a network, a checkbox │ #!│ has been added to control the rebuilding of the queue upon │ #!│ return from the Update Procedure. When checked, the queue │ #!│ will always be rebuilt to accomodate any updates made by other │ #!│ network file users, or multiple record adds by another procedure. │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Added 'Process Selected Record' code in the CASE FIELD() of List│ #!│ code, specifically to be used if the Hot Fields are enable. │ #!│3007.105 Competed support for PullDowns │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField #PROMPT('Range &Value Field',FIELD),%RangeValue #PROMPT('Record Filter',@S180),%RecordFilter #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc #PROMPT('Enable Hot Records',CHECK),%HotBar #PROMPT('&Queue Rebuild',CHECK),%QueueRebuild #PROMPT('Record Order',CHECK),%RecordOrder #PROMPT('Reverse Order',CHECK),%ReverseOrder #PROMPT('Progress &Indicator',CHECK),%ShowProg #PROMPT('Progress &Character',@S8),%ProgChar #PROTOTYPE('') #INSERT(%StandardHeader) #INSERT(%SetBrowseSymbols) #INSERT(%ListErrorCheck) %Procedure PROCEDURE Queue QUEUE !Listbox Queue contains FilePointer Ulong #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #SET(%FirstField, %Null) #FOR(%KeyField) QUE::%KeyField LIKE(%KeyField) #<! And Key element(s) for sort #IF(%FirstField = %Null) #SET(%FirstField, %KeyField) #SET(%FirstFieldSequence, %KeyFieldSequence) #ENDIF #IF(%RecordOrder = %Null) #IF(%KeyFieldSequence <> 'DESCENDING' AND %ReverseOrder = %Null) #SET(%SortString, (CLIP(LEFT(%SortString)) & ',+QUE::' & %KeyField)) #ELSE #SET(%SortString, (CLIP(LEFT(%SortString)) & ',-QUE::' & %KeyField)) #ENDIF #ENDIF #ENDFOR #IF((%RecordOrder AND %ReverseOrder)) #SET(%SortString,(','& %FixRows+1)) #ENDIF #FIX(%ScreenField,'?LIST') Line STRING(%ScreenFieldQueueSize) #<! Line to be scrolled . #INSERT(%SetupKeyRangeFields) ButtonIsDisabled BYTE !Flag to allow button enable #INSERT(%FileControl) InitialLoad BYTE(1) %LocalData %ScreenStructure #IF(%PullDown) %PulldownStructure SAV::PullDownOpened BYTE(0) #ENDIF #EMBED('Data Section') PreUpdateCount ULONG !Records in file count. FirstPage BYTE !First page flag #IF(%ShowProg) VEW::Length BYTE ! Progress variable VEW::ProgString STRING('<176>{80}') ! Progress display variable #ENDIF CODE #EMBED('Setup Procedure') #INSERT(%FileControl) OPEN(Screen) !Open the screen #EMBED('Setup Screen') DISPLAY !Display screen fields #IF(%Pulldown) #!If a Pulldown exists OPEN(%Pulldown) #<!Open the Pulldown SAV::PullDownOpened = True #EMBED('Setup Pulldown') #ENDIF #INSERT(%BuildListIndex) IF ?LIST = %FirstEntryField #<!If no entry for ranges DO FillQueue ! Fill the QUEUE IF RECORDS(Queue) = %FixRows #<! If no QUEUE records #IF(%InsertExists) SELECT(?Insert) ! Select the Insert button #ELSIF(%UpdateProc) #INSERT(%RestoreRangeFields) SETKEYCODE(InsKey) ! Set action to Insert Do UpdateProcedure ! Call the update procedure DO FillQueue ! Fill the QUEUE IF RECORDS(Queue) = %FixRows #<! If still no records DO ProcedureReturn END ! End IF #ELSE DO ProcedureReturn #ENDIF END ! End IF END !End IF #IF(%HotBar) #SET(%FirstRecordRow,(%FixRows+1)) GET(Queue,%FirstRecordRow) GET(%Primary,FilePointer) DISPLAY() #ENDIF LOOP !Screen handling loop #FOR(%Formula) #IF(UPPER(%FormulaClass) <> 'LIST') #IF(UPPER(%FormulaClass) <> 'FILTER') #INSERT(%GenerateFormula) #ENDIF #ENDIF #ENDFOR #EMBED('End of General Formulas') CASE SELECTED() !Jump to field setup routine #INSERT(%ScreenSetupRoutines) END !End CASE ACCEPT !Enable the keyboard CASE KEYCODE() !Jump to hotkey procedures #FOR(%HotKey) OF %HotKey !User defined HotKey %HotKeyProc !HotKey Procedure #ENDFOR #FIX(%ScreenField,'?Exit') #IF(%ScreenField) OF EscKey IF FIELD() <> ?Exit SELECT(?Exit) PRESS(EnterKey) CYCLE END #ENDIF END !End CASE IF REFER() AND SELECTED() = ?List | !If list field is selected AND FIELD() < ?List ! From a prior changed field DO FillQueue ! Fill the QUEUE END !End IF CASE FIELD() !Jump to edit routine #FOR(%ScreenField) #IF(%ScreenField = '?Insert') #IF(%UpdateProc) OF ?Insert !Process the Insert Button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Insert button Edit Routine #ENDIF GET(%Primary,0) #<! Dereference current record #INSERT(%ClearFileFields) #INSERT(%RestoreRangeFields) PreUpdateCount = Records(%Primary) #<! Save a record count SETKEYCODE(InsKey) ! Set action to Insert Do UpdateProcedure ! Call the update procedure #IF(%QueueRebuild) Do FillQueue ! Fill the QUEUE #ELSE CASE RECORDS(%Primary) #<! Check the record count OF PreUpdateCount ! If no change SELECT(?List) ! Reselect the list box OF PreUpdateCount + 1 ! If 1 record added #FIX(%ScreenField,'?List') Line = %ScreenFieldExpression #<! Fill the QUEUE line FilePointer = POINTER(%Primary) #<! Save the file pointer #INSERT(%FillKeyValues) ADD(Queue %SortString) #<! Add the record sorted ELSE ! Otherwise Do FillQueue ! Rebuild the QUEUE END ! End CASE #ENDIF SELECT(?List) ! Reselect the List field #ENDIF #ENDIF #IF(%ScreenField = '?Change') #IF(%UpdateProc) OF ?Change !Process the Change Button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Change button Edit Routine #ENDIF GET(Queue,CHOICE(?List)) !Get the QUEUE element GET(%Primary,FilePointer) #<!Get the record SETKEYCODE(EnterKey) ! Set action to Change Do UpdateProcedure ! Call the update procedure #IF(%QueueRebuild) Do FillQueue ! Fill the QUEUE #ENDIF #IF(%HotBar) GET(Queue,CHOICE(?List)) !Get the QUEUE element GET(%Primary,FilePointer) #<!Get the record #ENDIF SELECT(?List) ! Reselect the List field #ENDIF #ENDIF #IF(%ScreenField = '?Delete') #IF(%UpdateProc) OF ?Delete !Process the Delete Button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Delete button Edit Routine #ENDIF GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record SETKEYCODE(DelKey) ! Set action to Delete Do UpdateProcedure ! Call the update procedure #IF(%QueueRebuild) Do FillQueue ! Fill the QUEUE #ENDIF #IF(%HotBar) GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record #ENDIF SELECT(?List) ! Reselect the List field #ENDIF #ENDIF #IF(%ScreenField = '?List') OF ?List !Process the list field #IF(%HotBar) GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record #ENDIF #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Exit button Edit Routine #ENDIF #IF(%HotBar) #EMBED('Process Selected Record') DISPLAY() #<! Display the hot fields #ENDIF #IF(%UpdateProc) CASE KEYCODE() ! Jump to keycode routine #IF(%NoButtonsExist OR %InsertExists) OF InsKey ! For the insert key GET(%Primary,0) #<! Dereference current record #INSERT(%ClearFileFields) #INSERT(%RestoreRangeFields) PreUpdateCount = Records(%Primary) #<! Save a record count Do UpdateProcedure ! Call the update procedure #IF(%QueueRebuild) Do FillQueue ! Fill the QUEUE #ELSE CASE RECORDS(%Primary) #<! Check the record count OF PreUpdateCount ! If no change SELECT(?List) ! Reselect the list box OF PreUpdateCount + 1 ! If 1 record added #FIX(%ScreenField,'?List') Line = %ScreenFieldExpression #<! Fill the QUEUE line FilePointer = POINTER(%Primary) #<! Save the file pointer #INSERT(%FillKeyValues) ADD(Queue %SortString) #<! Add the record sorted ELSE ! Otherwise Do FillQueue ! Rebuild the QUEUE END ! End CASE #ENDIF SELECT(?List) ! Reselect the List field #ENDIF #IF(%NoButtonsExist OR %DeleteExists) OF DelKey ! For the delete key PreUpdateCount = Records(%Primary) ! Save a record count GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record Do UpdateProcedure ! Call the update procedure #IF(%QueueRebuild) Do FillQueue ! Fill the QUEUE #ELSE IF RECORDS(%Primary) = PreUpdateCount -1 #<! If the record was deleted DELETE(Queue) ! Delete the Queue entry END ! End IF #ENDIF #ENDIF #IF(%HotBar) GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record #ENDIF #IF(%NoButtonsExist OR %ChangeExists ) OF EnterKey ! Or the enter key OROF MouseLeft2 ! Or a double mouse click GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record Do UpdateProcedure ! Call the update procedure #IF(%QueueRebuild) Do FillQueue ! Fill the QUEUE #ENDIF #ENDIF #IF(%HotBar) GET(Queue,CHOICE(?List)) ! Get the QUEUE element GET(%Primary,FilePointer) #<! Get the record #ENDIF END ! End CASE keycode #ENDIF #ELSIF(%ScreenField = '?Exit') OF ?Exit !Process the Exit button #IF(%ScreenFieldEdit) %ScreenFieldEdit #<! Exit button Edit Routine #ENDIF DO ProcedureReturn #ELSE #INSERT(%ScreenEditRoutines) #ENDIF #ENDFOR #INSERT(%PulldownEditRoutines) END !End CASE FIELD() DISPLAY END !End LOOP DO ProcedureReturn FillQueue Routine #EMBED('Start of Fill Queue Routine') FREE(Queue) #<!Clear the QUEUE Firstpage = 1 !Set the FirstPage flag #IF(%ShowProg) #!If showing the progress VEW::Length = 1 !Set the status bar counter #ENDIF #FIX(%ScreenField,'?List') #FOR(%ScreenFieldFix) Line = %ScreenFieldFix #<!Add list box fields #IF(%RecordOrder = %Null) #IF(%FirstFieldSequence <> 'DESCENDING' AND %ReverseOrder = %Null) CLEAR(QUE::%FirstField) #<!Clear the key field #ELSE CLEAR(QUE::%FirstField,1) #<!Clear the key field #ENDIF #ENDIF ADD(Queue) !Add the fixed line DISPLAY(?List) #<!Blank the listbox #ENDFOR #IF(%RecordOrder) SET(%Primary) #<!Set to file order #ELSIF(%KeyRangeField) #IF(%ReverseOrder) #INSERT(%ClearRecordHigh) #ELSE #INSERT(%ClearRecordLow) #ENDIF %KeyRangeField = %RangeValue #<!Fill range field SET(%PrimaryKey,%PrimaryKey) #<!Set to keyed order #ELSE SET(%PrimaryKey) #<!Set to keyed order #ENDIF #IF(%ShowProg) #!If showing the progress VEW::ProgString = ALL(%ProgChar) #<!Fill the progress string #ENDIF LOOP !Get all selected records #IF(%RecordOrder) NEXT(%Primary) #<! Get the next record. #ELSIF(%ReverseOrder) PREVIOUS(%Primary) #<! Get the previous record #ELSE NEXT(%Primary) #<! Get the next record. #ENDIF IF ERRORCODE() THEN BREAK. ! Quit if an error occurs #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #IF(%KeyRangeField) #!If using a Range #IF(%KeyNoCase) #! Key is not case sensitive IF (UPPER(%KeyRangeField) <> UPPER(%RangeValue)) #<! If not in Range #ELSE IF (%KeyRangeField <> %RangeValue) #<! If not in Range #ENDIF BREAK #<! Break out of the Loop END ! End IF #ENDIF #IF(%RecordFilter) IF ~(%RecordFilter) #<! If Filter condition not met CYCLE ! Try another record END ! End IF #ELSE #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<! If Filter condition not met CYCLE ! Try another record END ! End IF #ELSE IF ~(%FormulaComputation) #<! If Filter condition not met CYCLE ! Try another record END ! End IF #ENDIF #ENDIF #ENDFOR #ENDIF #INSERT(%GetSecondaryRecords) #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'LIST') #INSERT(%GenerateFormula) #ENDIF #ENDFOR #EMBED('LIST Class formula') #IF(%ShowProg) #!If showing the progress #INSERT(%ShowFileProgress) #!Insert the progress code #ENDIF #FIX(%ScreenField,'?LIST') Line = %ScreenFieldExpression #<! Fill the QUEUE line FilePointer = POINTER(%Primary) #<! Fill the file pointer #FOR(%KeyField) QUE::%KeyField =%KeyField #<! Fill the key field #ENDFOR ADD(Queue %SortString) #<! Add to the QUEUE IF ERRORCODE() THEN BREAK. ! Quit out if error IF FirstPage ! If page 1 IF RECORDS(Queue) = ROWS(?List) ! If we have a full screen FirstPage = 0 ! turn off the page flag END ! End IF DISPLAY(?List) ! Display page 1 END ! End IF LOOP WHILE KEYBOARD() ! While Keyboard Input SELECT(?List) ! Select the List box ACCEPT ! Accept a Key IF KEYCODE() = EscKey ! If the Escape key DO ProcedureReturn END ! End IF DISPLAY(?List) ! Redisplay the list box END ! End LOOP END !End LOOP #IF(%ShowProg) #!If showing the progress CLEAR(StatusLine) DISPLAY(?StatusLine) #ENDIF EXIT #IF(%UpdateProc) UpdateProcedure ROUTINE #EMBED('Prior to Update Procedure') %UpdateProc #EMBED('After Update Procedure') #ENDIF #! !───────────────────────────────────────────────────────────────────────────── ProcedureReturn ROUTINE #IF(%ShowProg) #!If showing the progress ERASE(?StatusLine) !Clear the StatusLine #ENDIF DISPLAY !Redisplay the screen FREE(Queue) !Free the Queue memory #IF(%Pulldown) #!If a Pulldown exists IF SAV::PullDownOpened CLOSE(%Pulldown) #<!Close the Pulldown END #ENDIF CLOSE(%Screen) #INSERT(%FileControl) DO EndOfProcedureEmbed RETURN !───────────────────────────────────────────────────────────────────────────── EndOfProcedureEmbed ROUTINE #EMBED('End of Procedure') #EMBED('Custom Routines') #!*************************************************************************** #GROUP(%ShowFileProgress) VEW::Length += 1 StatusLine = ' Reading File: ' & SUB(VEW::ProgString,1,VEW::Length) IF VEW::Length = LEN(StatusLine) - 15 VEW::Length = 1 StatusLine = ' Reading File: ' & ' {65}' END Display(?StatusLine) #! #!*************************************************************************** #GROUP(%ListErrorCheck) #! #IF(%Primary = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: No file has been chosen for this procedure.')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' A file must be identified on the File Schematic.') #ERROR(%ErrorMessage) #ENDIF #IF(%KeyRangeField) #IF(UPPER(%KeyRangeField) = UPPER(%RangeValue)) #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' be separate fields.') #ERROR(%ErrorMessage) #ENDIF #IF(%KeyRangeField <> %Null and %RecordOrder <> %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limits may only be used with keyed order.')) #ERROR(%ErrorMessage) #SET(%ErrorMessage, ' Record order has been selected.') #ERROR(%ErrorMessage) #ENDIF #ENDIF #! #!*************************************************************************** #GROUP(%BuildListIndex) #FIX(%File, %Primary) #FIX(%Key, %PrimaryKey) #IF(%KeyIndex) BUILD(%PrimaryKey) #<!Build the index #ENDIF #! #!*************************************************************************** #CHAIN('LOOKUP.TPX')